home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / TUT05NEW.ZIP / TUT5.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-12-28  |  6.9 KB  |  214 lines
  1. (*****************************************************************************)
  2. (*                                                                           *)
  3. (* TUT3.PAS - VGA Trainer Program 5 (in Pascal)                              *)
  4. (*                                                                           *)
  5. (* "The VGA Trainer Program" is written by Denthor of Asphyxia.  However it  *)
  6. (* was limited to Pascal only in its first run.  All I have done is taken    *)
  7. (* his original release, translated it to C++, and touched up a few things.  *)
  8. (* I take absolutely no credit for the concepts presented in this code, and  *)
  9. (* am NOT the person to ask for help if you are having trouble.              *)
  10. (*                                                                           *)
  11. (* Program Notes : This program presents the basic demo scroller.            *)
  12. (*                                                                           *)
  13. (* Author        : Grant Smith (Denthor)  - denthor@beastie.cs.und.ac.za     *)
  14. (*                                                                           *)
  15. (*****************************************************************************)
  16.  
  17. {$X+} {$R-}
  18. Uses Crt;
  19.  
  20. CONST VGA = $a000;
  21.       XSize = 16;
  22.       YSize = 16;
  23.  
  24. TYPE
  25.         Letter = Array[1..xsize,1..ysize] of Byte;
  26.         Letters = Array[' '..']'] of Letter;
  27.  
  28. VAR Font : ^Letters;
  29.  
  30. {──────────────────────────────────────────────────────────────────────────}
  31. Procedure SetMCGA;  { This procedure gets you into 320x200x256 mode. }
  32. BEGIN
  33.   asm
  34.      mov        ax,0013h
  35.      int        10h
  36.   end;
  37. END;
  38.  
  39.  
  40. {──────────────────────────────────────────────────────────────────────────}
  41. Procedure SetText;  { This procedure returns you to text mode.  }
  42. BEGIN
  43.   asm
  44.      mov        ax,0003h
  45.      int        10h
  46.   end;
  47. END;
  48.  
  49. {──────────────────────────────────────────────────────────────────────────}
  50. procedure WaitRetrace; assembler;
  51.   { This waits until you are in a Verticle Retrace }
  52.  
  53. label
  54.   l1, l2;
  55. asm
  56.     mov dx,3DAh
  57. l1:
  58.     in al,dx
  59.     and al,08h
  60.     jnz l1
  61. l2:
  62.     in al,dx
  63.     and al,08h
  64.     jz  l2
  65. end;
  66.  
  67. {──────────────────────────────────────────────────────────────────────────}
  68. Procedure Pal(ColorNo : Byte; R,G,B : Byte);
  69.   { This sets the Red, Green and Blue values of a certain color }
  70. Begin
  71.    Port[$3c8] := ColorNo;
  72.    Port[$3c9] := R;
  73.    Port[$3c9] := G;
  74.    Port[$3c9] := B;
  75. End;
  76.  
  77.  
  78. {──────────────────────────────────────────────────────────────────────────}
  79. Procedure PutPixel (X,Y : Integer; Col : Byte; Where : Word);
  80.    { This puts a pixel at X,Y using color col, on VGA or the Virtual Screen}
  81. BEGIN
  82.   Mem [Where:X+(Y*320)]:=col;
  83. END;
  84.  
  85. {──────────────────────────────────────────────────────────────────────────}
  86. procedure LoadPal (FileName : string);
  87.    { This loads the Pallette file and puts it on screen }
  88. type DACType = array [0..255] of record
  89.                                 R, G, B : byte;
  90.                               end;
  91. var DAC : DACType;
  92.     Fil : file of DACType;
  93.     I : integer;
  94. BEGIN
  95.   assign (Fil, FileName);
  96.   reset (Fil);
  97.   read (Fil, DAC);
  98.   close (Fil);
  99.   for I := 0 to 255 do Pal(I,Dac[I].R,Dac[I].G,Dac[I].B);
  100. end;
  101.  
  102. {──────────────────────────────────────────────────────────────────────────}
  103. function Exist(FileName: string): Boolean;
  104.     { Checks to see if filename exits or not }
  105. var f: file;
  106. begin
  107.   {$I-}
  108.   Assign(f, FileName);
  109.   Reset(f);
  110.   Close(f);
  111.   {$I+}
  112.   Exist := (IOResult = 0) and
  113.    (FileName <> '');
  114. end;
  115.  
  116.  
  117. {──────────────────────────────────────────────────────────────────────────}
  118. Procedure Setup;
  119.   { This loads the font and the pallette }
  120. VAR f:file;
  121.     loop1:char;
  122.     loop2,loop3:integer;
  123. BEGIN
  124.   getmem (font,sizeof (font^));
  125.   If exist ('softrock.fnt') then BEGIN
  126.     Assign (f,'softrock.fnt');
  127.     reset (f,1);
  128.     blockread (f,font^,sizeof (font^));
  129.     close (f);
  130.     Writeln ('SoftRock.FNT from TEXTER5 found in current directory. Using.');
  131.   END
  132.   ELSE BEGIN
  133.     Writeln ('SoftRock.FNT from TEXTER5 not found in current directory.');
  134.     For loop1:=' ' to ']' do
  135.       For loop2:=1 to 16 do
  136.         for loop3:=1 to 16 do
  137.           font^[loop1,loop2,loop3]:=loop2;
  138.   END;
  139.   If exist ('pallette.col') then
  140.     Writeln ('Pallette.COL from TEXTER5 found in current directory. Using.')
  141.   ELSE
  142.     Writeln ('Pallette.COL from TEXTER5 not found in current directory.');
  143.   Writeln;
  144.   Writeln;
  145.   Write ('Hit any key to continue ...');
  146.   readkey;
  147.   setmcga;
  148.   If exist ('pallette.col') then loadpal ('pallette.col');
  149. END;
  150.  
  151.  
  152. {──────────────────────────────────────────────────────────────────────────}
  153. Procedure ScrollMsg (Msg : String);
  154.   { This scrolls the string in MSG across the screen }
  155. Var Loop1,loop2,loop3 : Integer;
  156. Begin
  157.   For loop1:=1 to length (msg) do BEGIN
  158.     For loop2:=1 to xsize do BEGIN
  159.  
  160.       { This bit scrolls the screen by one then puts in the new row of
  161.         letters }
  162.  
  163.       waitretrace;
  164.       For Loop3 := 100 to 99+ysize do
  165.         move (mem[vga:1+(loop3*320)],mem[vga:(loop3*320)],319);
  166.       for loop3:=100 to 99+ysize do
  167.         putpixel (319,loop3,font^[msg[loop1],loop2,loop3-99],vga);
  168.            { Change the -99 above to the minimum of loop3-1, which you
  169.              will change in order to move the position of the scrolly }
  170.     END;
  171.  
  172.     {This next bit scrolls by one pixel after each letter so that there
  173.       are gaps between the letters }
  174.  
  175.     waitretrace;
  176.     For Loop3 := 100 to 99+ysize do
  177.       move (mem[vga:1+(loop3*320)],mem[vga:(loop3*320)],319);
  178.       for loop3:=100 to 99+ysize do
  179.         putpixel (319,loop3,0,vga);
  180.   END;
  181. End;
  182.  
  183.  
  184. BEGIN
  185.   ClrScr;
  186.   Writeln ('This program will give you an example of a scrolly. If the file');
  187.   Writeln ('SOFTROCK.FNT is in the current directory, this program will scroll');
  188.   Writeln ('letters, otherwise it will only scroll bars. It also searches for');
  189.   Writeln ('PALLETTE.COL, which it uses for it''s pallette. Both SOFTROCK.FNT');
  190.   Writeln ('and PALLETTE.COL come with TEXTER5.ZIP, at a BBS near you.');
  191.   Writeln;
  192.   Writeln ('You will note that you can change what the scrolly says merely by');
  193.   Writeln ('changing the string in the program.');
  194.   Writeln;
  195.   Setup;
  196.   repeat
  197.     ScrollMsg ('ASPHYXIA RULZ!!!   ');
  198.   until keypressed;
  199.   Settext;
  200.   freemem (font, sizeof (font^));
  201.   Writeln ('All done. This concludes the fifth sample program in the ASPHYXIA');
  202.   Writeln ('Training series. You may reach DENTHOR under the name of GRANT');
  203.   Writeln ('SMITH on the MailBox BBS, or leave a message to ASPHYXIA on the');
  204.   Writeln ('ASPHYXIA BBS. Get the numbers from Roblist, or write to :');
  205.   Writeln ('             Grant Smith');
  206.   Writeln ('             P.O. Box 270');
  207.   Writeln ('             Kloof');
  208.   Writeln ('             3640');
  209.   Writeln ('I hope to hear from you soon!');
  210.   Writeln; Writeln;
  211.   Write   ('Hit any key to exit ...');
  212.   Readkey;
  213. END.
  214.